home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
tjockdem.arc
/
DEMO5.ARC
/
IODEM3.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-02-03
|
11KB
|
300 lines
Program IOTTT5_Demo_3;
{IMPORTANT NOTE: Set Options Compile Conditional Defines to IOFull and
select Compile Build.
}
{$V-} {don't check string lengths}
USES DOS, CRT, FASTTTT5, WINTTT5, IOTTT5, KeyTTT5, Strnttt5, MiscTTT5;
CONST
Big_Field_width = 40;
TYPE
Customer_Rec = Record
Title : String[Big_Field_Width];
Company : String[Big_Field_Width];
Addr1 : string[Big_Field_Width];
Addr2 : string[Big_Field_Width];
City : string[Big_Field_Width];
State : string[2];
Zip : string[9];
Number : string[10];
end;
Item_Rec = record
Item : byte;
Quantity : word;
Description : string[50];
Price : real;
ExtendedPrice : real;
end;
Display_Cols = record
TextF : byte;
Back : byte;
MsgF : byte;
MsgB : Byte;
FieldHiF : byte;
FieldHiB : Byte;
FieldLoF : Byte;
FieldLoB : Byte;
BoxF : Byte;
HeadF : Byte;
end;
VAR
Cust : Customer_Rec;
OurRef : string[10];
ODate : dates;
Items: array[1..3] of Item_Rec;
Screen_Cols : Display_Cols;
Procedure Init_Vars;
{}
begin
FillChar(Cust,sizeof(Cust),#0);
Cust.Title := 'Bob Ainsbury';
FillChar(Items,SizeOf(Items),#0);
OurRef:= '';
Odate := Today_in_Julian;
With Screen_Cols do
If BaseOfScreen = $B800 then {color}
begin
TextF := white;
Back := Blue;
MsgF := yellow;
MsgB := red;
FieldHiF := white;
FieldHiB := red;
FieldLoF := Lightgray;
FieldLoB := black;
BoxF := lightcyan;
HeadF := white;
end
else
begin
TextF := lightgray;
Back := black;
MsgF := white;
MsgB := black;
FieldHiF := black;
FieldHiB := lightgray;
FieldLoF := white;
FieldLoB := black;
BoxF := white;
HeadF := white;
end;
end; {of proc Init}
Procedure Set_Screen;
{}
begin
ClearText(1,1,80,25,white,black);
With Screen_Cols do
begin
FBox(1,1,80,21,BoxF,Back,2);
WriteCenter(21,TextF,back,'Copyright (c) 1988 TechnoJock Software Inc.');
WriteCenter(1,HeadF,back,' Order Entry Screen ');
WriteAt(64,1,TextF,back,' F10 to Quit ');
WriteAt(19,3,TextF,back,'Name');
WriteAT(19,4,TextF,back,'Company');
WriteAT(19,5,TextF,back,'Address 1');
WriteAT(19,6,TextF,back,'Address 2');
WriteAT(19,7,TextF,back,'City');
WriteAT(19,8,TextF,back,'State Zip');
WriteAT(53,8,TextF,back,'Telephone');
WriteAT(8,10,TextF,back,'Our Reference: Order Date');
WriteAT(8,12,TextF,back,' UNIT EXT.');
WriteAT(8,13,TextF,back,'ITEM QUANTITY DESCRIPTION PRICE PRICE');
WriteAT(64,19,TextF,back,'Total');
end;
WriteAT(3,23,lightcyan,black,'This demo input routine was written using the IOTTT5 unit of TechnoJock''s');
WriteAT(3,24,lightcyan,black,'Turbo Toolkit v5.0 . The unit is easy to use and supports dependent field');
WriteAT(3,25,lightcyan,black,'update, field format control, automatic range checking, and much much more!');
end; {of proc Set_Screen}
Procedure Set_Fields;
{}
var I : Integer;
begin
Create_Tables(1);
Activate_Table(1);
With Screen_Cols do
Define_Colors(FieldHiF, FieldHiB, FieldLoF, FieldLoB, MsgF, MsgB);
Allow_Esc(true);
Create_Fields(22);
Add_Field(1, 22,2,22,2, 32,3);
Add_Field(2, 1,3,1,3, 32,4);
Add_Field(3, 2,4,2,4, 32,5);
Add_Field(4, 3,5,3,5, 32,6);
Add_Field(5, 4,6,3,6, 32,7);
Add_Field(6, 5,7,5,7, 32,8);
Add_Field(7, 6,8,6,8, 41,8);
Add_Field(8, 7,9,7,9, 65,8);
Add_Field(9, 8,10,8,10, 25,10);
Add_Field(10, 9,11,9,11, 64,10);
Add_Field(11,10,15,10,12, 8,15);
Add_Field(12,11,16,11,13, 15,15);
Add_Field(13,12,17,12,14, 21,15);
Add_Field(14,13,18,13,15, 63,15);
Add_Field(15,11,19,14,16, 8,16);
Add_Field(16,12,20,15,17, 15,16);
Add_Field(17,13,21,16,18, 21,16);
Add_Field(18,14,22,17,19, 63,16);
Add_Field(19,15, 1,18,20, 8,17);
Add_Field(20,16, 1,19,21, 15,17);
Add_Field(21,17, 1,20,22, 21,17);
Add_Field(22,18, 1,21, 1, 63,17);
String_Field(1, Cust.Title, replicate(Big_Field_Width,'*'));
String_Field(2, Cust.Company, replicate(Big_Field_Width,'*'));
String_Field(3, Cust.Addr1, replicate(Big_Field_Width,'*'));
String_Field(4, Cust.Addr2, replicate(Big_Field_Width,'*'));
String_Field(5, Cust.City, replicate(Big_Field_Width,'*'));
String_Field(6, Cust.State, '!!');
String_Field(7, Cust.Zip, '#####-####');
String_Field(8, Cust.Number, '(###) ###-####');
Field_Rules(8, RightJustify+AllowNull,[#0],[#0]);
String_Field(9, OurRef, '!!!!#####');
Add_Message(9,0,20,'Look in File 63.B - format 4 characters and 5 numbers');
Date_Field(10, ODate, MMDDYY,'',0,0);
For I := 1 to 3 do
begin
Byte_Field(11+pred(I)*4, Items[I].Item, '###', 101,105);
Field_Rules(11+pred(I)*4, JumpIfFull+SuppressZero+allownull,[#0],[#0]);
Add_Message(11+pred(I)*4, 0,20, 'Enter 101, 102, 103, 104 or 105');
Word_Field(12+pred(I)*4, Items[I].Quantity, '###', 0, 999);
String_Field(13+pred(I)*4,Items[I].Description, replicate(Big_Field_Width,'*'));
Real_Field(14+pred(I)*4, Items[I].Price, '###.##',0,0);
Field_Rules(14+pred(I)*4,
SuppressZero+RightJustify+AllowNull,
[#0],[#0]);
end;
end; {of proc Set_Fields}
Procedure Update_Description(ItemNO : byte;var Str : string; Var Price : real);
begin
case ItemNo of
101 : begin
Str := 'TechnoJock''s Fiction Toolbox';
Price := 49.95;
end;
102 : begin
Str := 'TechnoJock''s Turbo Toolkit';
Price := 49.95;
end;
103 : begin
Str := 'TechnoJock''s Tutorials';
Price := 10.00;
end;
104 : begin
Str := 'Home Management System';
Price := 10.00;
end;
105 : begin
Str := 'TechnoJock Upgrade';
Price := 15.00
end;
end;
end;
Procedure Update_Totals;
var
Sub1,Sub2,Sub3 : real;
begin
Sub1 := Items[1].Price * Items[1].Quantity;
Sub2 := Items[2].Price * Items[2].Quantity;
Sub3 := Items[3].Price * Items[3].Quantity;
with Screen_Cols do
begin
WriteAT(72,15,BoxF,back,PadRight(Real_to_Str(Sub1,2),7,' '));
WriteAT(72,16,BoxF,back,Padright(Real_to_Str(Sub2,2),7,' '));
WriteAT(72,17,BoxF,back,Padright(Real_to_Str(Sub3,2),7,' '));
WriteAT(72,19,BoxF,back,PadRight(Real_to_Str(Sub1+Sub2+Sub3,2),7,' '));
end;
end;
Procedure Help;
const
X1 = 15;
Y1 = 5;
X2 = 65;
Y2 = 20;
var Ch : char;
begin
with Screen_Cols do
begin
MkWin(X1,Y1,X2,Y2,FieldHiF,FieldHiB,1);
WriteBetween(X1,X2,Y1,FieldHiF,FieldHiB,' H E L P ');
WriteBetween(X1,X2,Y1+(Y2-Y1)div 2,FieldHiF,FieldHiB,'Just imagine there is help!!');
Ch := GetKey;
RmWin;
end;
end;
{$F+}
procedure Key_Press_Check(var C : char;var CF:byte; var Refresh:Byte);
begin
If C = #187 then
begin
Help;
C := No_Char;
end;
end;
Procedure Update_Dependent_Fields(var CF:byte; var Refresh:byte);
begin
Case CF of
11 : With Items[1] do
begin
If (Description = '')
and (Price = 0.0) then
begin
Update_Description(Item,Description,Price);
Refresh := Refresh_All;
end;
end;
15 : With Items[2] do
begin
If (Description = '')
and (Price = 0.0) then
begin
Update_Description(Item,Description,Price);
Refresh := Refresh_All;
end;
end;
19 : With Items[3] do
begin
If (Description = '')
and (Price = 0.0) then
begin
Update_Description(Item,Description,Price);
Refresh := Refresh_All;
end;
end;
12,16,20,
14,18,24 : begin
Update_Totals;
Refresh := Refresh_All;
end;
end; {Case}
end;
{$F-}
begin
Init_Vars;
Set_Screen;
Set_Fields;
With Table[CurrentTable]^.ITTT do
ErrorLine := 21;
Assign_LeaveFieldHook(Update_Dependent_Fields);
Assign_CharHook(Key_Press_Check);
Process_Input(11);
Clrscr;
WriteAT(1,1,white,black,'Run DemoTTT.exe for the main demo program');
WriteAT(1,2,white,black,'TechnoJock''s Turbo Toolkit v5.0');
GotoXY(1,5);
end.